home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pas_all.zip
/
TI669.ASC
< prev
next >
Wrap
Text File
|
1992-08-12
|
4KB
|
199 lines
PRODUCT : Turbo Pascal NUMBER : 669
VERSION : 6.0
OS : MS/PC DOS
DATE : August 12, 1992 PAGE : 1/3
TITLE : Change Menubar at Runtime
{
This program changes the menubar at runtime as well
as demonstrates how to create a menuitem that does not
have a submenu.
}
{$X+}
program ExampleProgram;
uses
Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
const
PuzzleCmd = 100;
CalendarCmd = 101;
SwitchCmd = 102;
type
TTestMain = object(TApplication)
OtherMenu: PMenuBar;
constructor Init;
procedure Calendar;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitMenuBar; virtual;
procedure Puzzle;
procedure SwitchMenu;
end;
{ TTestMain }
constructor TTestMain.Init;
begin
TApplication.Init;
end;
procedure TTestMain.Calendar;
var
CalendarWindow: PCalendarWindow;
begin
CalendarWindow := new(PCalendarWindow, Init);
DeskTop^.Insert(CalendarWindow);
end;
procedure TTestMain.HandleEvent(var Event: TEvent);
PRODUCT : Turbo Pascal NUMBER : 669
VERSION : 6.0
OS : MS/PC DOS
DATE : August 12, 1992 PAGE : 2/3
TITLE : Change Menubar at Runtime
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand Then
begin
case Event.Command of
PuzzleCmd : Puzzle;
CalendarCmd : Calendar;
SwitchCmd : SwitchMenu;
else
Exit;
end;
ClearEvent(Event);
end;
end;
Procedure TTestMain.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y+1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
NewSubMenu('~E~xample',hcNoContext,NewMenu(
NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
NewLine(
NewItem('~Q~uit', '',0, cmQuit,
hcNoContext,Nil))))),Nil)))));
OtherMenu := New(PMenuBar, Init(R, NewMenu(
NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
NewItem('~B~y', '', 0, cmQuit, hcNoContext,
NewLine(
NewItem('~Q~uit', '',0, cmQuit,
hcNoContext,Nil)))),Nil)))));
end;
procedure TTestMain.Puzzle;
var
PuzzleWindow: PPuzzleWindow;
begin
PuzzleWindow := new(PPuzzleWindow, Init);
PRODUCT : Turbo Pascal NUMBER : 669
VERSION : 6.0
OS : MS/PC DOS
DATE : August 12, 1992 PAGE : 3/3
TITLE : Change Menubar at Runtime
DeskTop^.Insert(PuzzleWindow);
end;
procedure TTestMain.SwitchMenu;
var
Temp: PMenuBar;
begin
Delete(MenuBar);
Temp := PMenuBar(MenuBar);
MenuBar := OtherMenu;
OtherMenu := Temp;
Insert(MenuBar);
MenuBar^.DrawView;
end;
var
TestMain: TTestMain;
begin
TestMain.Init;
TestMain.Run;
TestMain.Done;
end.
DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.